#COMPILE EXE "iCalendar Generator.exe"
#DIM ALL
$VER = "0.1"

'------------------------------------------------------------------------------
'   ** Includes **
'------------------------------------------------------------------------------
#INCLUDE ONCE "Win32Api.inc"
#INCLUDE ONCE "inc\RTF.inc"
#INCLUDE ONCE "inc\Julian.inc"
'------------------------------------------------------------------------------
#RESOURCE     "res\iCalendar Generator.pbr"
'-------------------------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'   ** Constants **
'------------------------------------------------------------------------------
%IDC_LABEL1   = 1001
%IDC_LABEL2   = 1002
%IDC_LABEL3   = 1003
%IDC_L_YSTA   = 1004 ' Label for Year-Start
%IDC_L_YCNT   = 1005 ' Label for Year-Count
%IDC_UD_YSTA  = 1006 ' Up-Down control for Year-Start
%IDC_UD_YCNT  = 1007 ' Up-Down control for Year-Count
%IDC_T_YSTA   = 1008 ' Textbox control for Year-Start
%IDC_T_YCNT   = 1009 ' Textbox control for Year-Count
%IDC_BUTTON1  = 1010
%IDC_BUTTON2  = 1011
%IDC_TEXTBOX  = 1012

'------------------------------------------------------------------------------
'   ** Globals **
'------------------------------------------------------------------------------
GLOBAL evok AS LONG
GLOBAL evko AS LONG
GLOBAL icsf AS STRING
GLOBAL erli AS STRING
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'   ** Main Application Entry Point **
'------------------------------------------------------------------------------
FUNCTION PBMAIN()
    LoadLibrary("RICHED32.DLL")
    ShowMain %HWND_DESKTOP
END FUNCTION
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'   ** Functions / Subs **
'------------------------------------------------------------------------------
MACRO CFGFILE = EXE.PATH$ + EXE.NAME$ + ".cfg"
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
FUNCTION NowUTCstamp() AS STRING
    LOCAL e, r AS STRING
    e = DATE$
    r  = RIGHT$(e,4) + LEFT$(e,2) + MID$(e,4,2) + "T"
    e = TIME$
    r += LEFT$(e,2) + MID$(e,4,2) + RIGHT$(e,2) + "Z"
    FUNCTION = r
END FUNCTION
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
FUNCTION UID() AS STRING
    LOCAL e, r  AS STRING
    LOCAL i     AS LONG

    e = GUID$
    FOR i = 1 TO LEN(e)
        r += HEX$(ASC(e,i), 2)
        IF LEN(r) = 23 OR LEN(r) = 18 OR LEN(r) = 13 OR LEN(r) = 8 THEN r += "-"
    NEXT

    FUNCTION = LCASE$(r)
END FUNCTION
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
FUNCTION IcsDate(BYVAL y AS LONG, BYVAL m AS LONG, BYVAL d AS LONG) AS STRING
    LOCAL e, r AS STRING
    e = TRIM$(STR$(y)) : WHILE LEN(e) < 4 : e = "0" + e : WEND
    r  = e
    e = TRIM$(STR$(m)) : IF LEN(e) < 2 THEN e = "0" + e
    r += e
    e = TRIM$(STR$(d)) : IF LEN(e) < 2 THEN e = "0" + e
    r += e
    FUNCTION = r
END FUNCTION
'------------------------------------------------------------------------------

'-------------------------------------------------------------------------------------------------
FUNCTION Exist(BYVAL fileOrFolder AS STRING) AS LONG
    LOCAL Dummy&
    Dummy& = GETATTR(fileOrFolder)
    FUNCTION = (ERRCLEAR = 0)
END FUNCTION
'-------------------------------------------------------------------------------------------------

'-------------------------------------------------------------------------------------------------
FUNCTION Get_Resource(BYVAL rid AS LONG) AS STRING
    LOCAL L1, L2 AS LONG
    LOCAL D1, D2 AS DWORD

    L1 = FindResource  (GetModuleHandle(""), "#"+FORMAT$(rid), BYVAL %RT_RCDATA)
    D2 = SizeofResource(GetModuleHandle(""), L1)
    L2 = LoadResource  (GetModuleHandle(""), L1)
    D1 = LockResource  (L2)

    FUNCTION = PEEK$(D1,D2)
END FUNCTION
'-------------------------------------------------------------------------------------------------

'-------------------------------------------------------------------------------------------------
SUB DumpStandardCfgFile()
    LOCAL ff AS LONG
    KILL CFGFILE
    ff = FREEFILE
    OPEN CFGFILE FOR BINARY AS #ff
    PUT$ #ff, Get_Resource(10)      ' iCalendar Generator.cfg
    CLOSE #ff
END SUB
'-------------------------------------------------------------------------------------------------

'-------------------------------------------------------------------------------------------------
SUB GenerateIcs(BYVAL ysta AS LONG, BYVAL ycnt AS LONG)
    LOCAL ffi   AS LONG
    LOCAL ffo   AS LONG
    LOCAL lin   AS LONG
    LOCAL y,m,d AS LONG
    LOCAL i,j,k AS LONG
    LOCAL em,ed AS LONG ' Easter month/day
    LOCAL e,s   AS STRING

    erli = ""           ' Reset lines in error
    evok = 0
    evko = 0

    ffo = FREEFILE
    KILL icsf
    OPEN icsf FOR OUTPUT ACCESS WRITE LOCK READ WRITE AS #ffo

    PRINT #ffo, "BEGIN:VCALENDAR"
    PRINT #ffo, "PRODID:"+EXE.NAME$+" - http://mougino.free.fr"
    PRINT #ffo, "VERSION:2.0"
    PRINT #ffo, ""

    FOR y = ysta TO ysta + ycnt - 1

        ' Calculate Easter Date
        em = 3 : ed = EasterDate(y)
        IF ed > 31 THEN ' Easter in April
            em  = 4 : ed -= 31
        END IF

        ' Open Script File for Input
        ffi = FREEFILE
        OPEN CFGFILE FOR INPUT ACCESS READ LOCK SHARED AS #ffi
        lin = 0
        DO
            LINE INPUT #ffi, e : e = TRIM$(e) : INCR lin
            IF e = "" OR LEFT$(e, 1) = "#" THEN ITERATE LOOP            ' ignore comments & empty lines
            i = INSTR(e,"#")
            IF i > 0 THEN e = TRIM$(LEFT$(e,i-1))                       ' remove inline comments
            i = INSTR(e,"=")
            IF i = 0 THEN GOSUB LineInError : ITERATE LOOP              ' line must contain an '='
            s = UCASE$(TRIM$(LEFT$(e,i-1)))
            e = TRIM$(MID$(e,i+1))
            IF INSTR(s,"/") > 0 THEN                                    ' fixed date "dd/mm"
                i = INSTR(s,"/")
                d = VAL(LEFT$(s,i-1))
                m = VAL( MID$(s,i+1))
                IF d=0 OR m=0 THEN
                    GOSUB LineInError
                ELSE
                    GOSUB WriteIcsEvent
                END IF
            ELSEIF INSTR(s,"E+") = 1 THEN                               ' date based on Easter (after)
                i = VAL(MID$(s,3))
                j = Julian(y, em, ed) + i
                s = Julian2Date(j)
                y = VAL(LEFT$(s,4))
                m = VAL(MID$(s,5,2))
                d = VAL(RIGHT$(s,2))
                GOSUB WriteIcsEvent
            ELSEIF INSTR(s,"E-") = 1 THEN                               ' date based on Easter (before)
                i = VAL(MID$(s,3))
                j = Julian(y, em, ed) - i
                s = Julian2Date(j)
                y = VAL(LEFT$(s,4))
                m = VAL(MID$(s,5,2))
                d = VAL(RIGHT$(s,2))
                GOSUB WriteIcsEvent
            ELSE                                                        ' date neither fixed,
                GOSUB LineInError                                       ' nor based on Easter
            END IF
        LOOP UNTIL EOF(#ffi)
        CLOSE #ffi
    NEXT

    PRINT #ffo, "END:VCALENDAR"
    CLOSE #ffo
    erli = RTRIM$(erli, ";")
    EXIT SUB

LineInError:
'-----------
erli += TRIM$(STR$(lin))+";"
INCR evko
RETURN

WriteIcsEvent:
'-------------
PRINT #ffo, "BEGIN:VEVENT"
PRINT #ffo, "DTSTAMP:" + NowUTCstamp()
PRINT #ffo, "DTSTART;VALUE=DATE:" + IcsDate(y,m,d)
PRINT #ffo, "SUMMARY:" + e
PRINT #ffo, "TRANSP:OPAQUE"
PRINT #ffo, "X-MICROSOFT-CDO-BUSYSTATUS:OOF"
PRINT #ffo, "UID:" + UID() + "@mougino.free.fr"
PRINT #ffo, "END:VEVENT"
PRINT #ffo, ""
INCR evok
RETURN

END SUB
'-------------------------------------------------------------------------------------------------

'-------------------------------------------------------------------------------------------------
SUB Fill_RichEdit (hD AS DWORD, CtlId AS LONG)
    LOCAL richtext AS STRING

    richtext  = "[black][c]"
    richtext += "[h:lime][font:a,11][b]Outlook instructions[/b][/h][eol][l]"

    richtext += "[font:a,9][black][l][eol]"
    richtext += "In Outlook, while in the Calendar view, click [blue]File [black]> [blue]Open & Export "
    richtext += "[black]then [blue]Import/Export [black] and finally choose ""[blue]Import an iCalendar "
    richtext += "(.ics) or vCalendar file (.vcs)[black]"" then click Next.[eol]"
    richtext += "[eol]"
    richtext += "Locate the iCalendar file (.ics) that you generated with this program, and when asked "
    richtext += "if you want to open this calendar as a new calendar or import its items into your "
    richtext += "calendar, choose ""[blue]Import[black]""."
    richtext += "[eop]"

    richtext += "[eol]"
    richtext += "[c][b][maroon]C[red]r[fuschia]e[purple]a[blue]t[teal]e[green]d [lime]b[grey]y [maroon]m[red]o[fuschia]u[purple]g[blue]i[teal]n[green]o[lime]"
    richtext += " - http://mougino.free.fr[/b]"
    richtext += "[eol]"
    richtext += "[eop]"

    RTF_SET hD, CtlId, richtext
END SUB
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'   ** CallBacks **
'------------------------------------------------------------------------------
MACRO Y_LAST = IIF$(ycnt>1, "-"+TRIM$(STR$(ysta+ycnt-1)), "")
'------------------------------------------------------------------------------
CALLBACK FUNCTION ProcMain()
    LOCAL t AS STRING

    SELECT CASE AS LONG CB.MSG
        CASE %WM_INITDIALOG
            ' Initialization handler
            SendMessage GetDlgItem(CB.HNDL,%IDC_TEXTBOX), %EM_setBkgndColor, _
                        %False, GetSysColor(%COLOR_MENU)
            IF NOT EXIST(CFGFILE) THEN
                DumpStandardCfgFile()
            END IF

        CASE %WM_NOTIFY
            ' Special RichEdit notifications
            IF CB.NMID = %IDC_TEXTBOX AND CB.NMCODE = %EN_LINK THEN
                RTF_hyperlink (CB.HNDL, %IDC_TEXTBOX, CB.LPARAM)
            END IF

        CASE %WM_COMMAND
            ' Process control messages
            SELECT CASE AS LONG CB.CTL
                CASE %IDC_T_YSTA ' Year Start UpDown/TxtBox
                    IF CB.CTLMSG = %EN_CHANGE THEN
                        CONTROL GET TEXT CB.HNDL, %IDC_T_YSTA TO t
                        t = REMOVE$(t, CHR$(160))
                        CONTROL SET TEXT CB.HNDL, %IDC_L_YSTA, t
                    END IF

                CASE %IDC_T_YCNT ' Year Count UpDown/TxtBox
                    IF CB.CTLMSG = %EN_CHANGE THEN
                        CONTROL GET TEXT CB.HNDL, %IDC_T_YCNT TO t
                        t = REMOVE$(t, CHR$(160))
                        CONTROL SET TEXT CB.HNDL, %IDC_L_YCNT, t
                    END IF

                CASE %IDC_BUTTON1 ' View/change holiday script
                    IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
                        ShellExecute 0, "open", CFGFILE, "", "", %SW_SHOW
                    END IF

                CASE %IDC_BUTTON2 ' GENERATE ICS
                    LOCAL ysta, ycnt AS LONG
                    IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
                        CONTROL GET TEXT CB.HNDL, %IDC_L_YSTA TO t : ysta = VAL(t)
                        CONTROL GET TEXT CB.HNDL, %IDC_L_YCNT TO t : ycnt = VAL(t)
                        DISPLAY SAVEFILE CB.HNDL, -50, -50, EXE.NAME$, EXE.PATH$, _
                            "iCalendar" + CHR$(0) + "*.ics" + CHR$(0), _
                            "Public Holidays "+TRIM$(STR$(ysta))+Y_LAST+".ics", _
                            "ics", %OFN_PATHMUSTEXIST OR %OFN_OVERWRITEPROMPT TO t
                        IF t = "" THEN EXIT FUNCTION ' Cancelled by user
                        icsf = t ' Global string 'ICS file'
                        GenerateIcs ysta, ycnt
                        t  = "iCalendar successfully generated for the year" + IIF$(ycnt>1,"s","")
                        t += " " + TRIM$(STR$(ysta)) + Y_LAST + " :" + $CR + $CR
                        t += "- " + TRIM$(STR$(evok)) + " event(s) generated" + $CR + $CR
                        t += "- " + TRIM$(STR$(evko)) + " error(s)"
                        IF erli <> "" THEN
                            t += " at script line"+IIF$(INSTR(erli,";")>0,"s "," ")+erli
                        END IF
                        MessageBox CB.HNDL, (t), EXE.NAME$, %MB_ICONINFORMATION
                    END IF

            END SELECT
    END SELECT
END FUNCTION
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'   ** Dialogs **
'------------------------------------------------------------------------------
%UDS_WRAP             = &H0001
%UDS_SETBUDDYINT      = &H0002
%UDS_ARROWKEYS        = &H0020
%UDM_SETRANGE         = %WM_USER + 101
%UDM_SETBUDDY         = %WM_USER + 105
'------------------------------------------------------------------------------
FUNCTION ShowMain(BYVAL hParent AS DWORD) AS LONG
    LOCAL hDlg AS DWORD
    LOCAL hIco AS DWORD
    LOCAL lRes AS LONG
    LOCAL year AS STRING

    year = DATE$ : year = RIGHT$(year, 4)

    DIALOG NEW PIXELS, hParent, EXE.NAME$+$SPC+$VER, 514, 250, 355, 328, _
        %WS_POPUP OR %WS_BORDER OR %WS_DLGFRAME OR %WS_CAPTION OR _
        %WS_SYSMENU OR %WS_MINIMIZEBOX OR %WS_CLIPSIBLINGS OR %WS_VISIBLE OR _
        %DS_MODALFRAME OR %DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT, _
        %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR _
        %WS_EX_RIGHTSCROLLBAR, TO hDlg

    hIco = ExtractIcon(GetModuleHandle(""), "imageres.dll", 272)
    SetClassLong(hDlg, %GCL_HICONSM, hIco)
    SetClassLong(hDlg, %GCL_HICON, hIco)

    CONTROL ADD LABEL,   hDlg, %IDC_LABEL1, "Start at year :", 16, 16, 72, 16
    CONTROL ADD LABEL,   hDlg, %IDC_L_YSTA, year, 88, 14, 40, 20, %WS_CHILD _
        OR %WS_VISIBLE OR %WS_BORDER OR %SS_CENTER OR %SS_CENTERIMAGE, _
        %WS_EX_LEFT OR %WS_EX_LTRREADING
    CONTROL SET COLOR    hDlg, %IDC_L_YSTA, -1, %WHITE
    CONTROL ADD "msctls_updown32", hDlg, %IDC_UD_YSTA, "", 88+40+2, 12, 34, 24, _
        %WS_CHILD OR %WS_VISIBLE OR %UDS_WRAP OR %UDS_SETBUDDYINT OR %UDS_ARROWKEYS
    CONTROL ADD TEXTBOX, hDlg, %IDC_T_YSTA, year, -10, -10, 1, 1
    CONTROL SEND hDlg, %IDC_UD_YSTA, %UDM_SETBUDDY, GetDlgItem(hDlg, %IDC_T_YSTA), 0&
    CONTROL SEND hDlg, %IDC_UD_YSTA, %UDM_SETRANGE, 0&, MAKLNG (9999,0)

    CONTROL ADD LABEL,   hDlg, %IDC_LABEL2, "and generate for", 152, 16, 88, 16, %SS_CENTER
    CONTROL ADD LABEL,   hDlg, %IDC_L_YCNT, "1", 240, 14, 32, 20, %WS_CHILD _
        OR %WS_VISIBLE OR %WS_BORDER OR %SS_CENTER OR %SS_CENTERIMAGE, _
        %WS_EX_LEFT OR %WS_EX_LTRREADING
    CONTROL SET COLOR    hDlg, %IDC_L_YCNT, -1, %WHITE
    CONTROL ADD "msctls_updown32", hDlg, %IDC_UD_YCNT, "", 240+32+2, 12, 34, 24, _
        %WS_CHILD OR %WS_VISIBLE OR %UDS_WRAP OR %UDS_SETBUDDYINT OR %UDS_ARROWKEYS
    CONTROL ADD TEXTBOX, hDlg, %IDC_T_YCNT, "1", -10, -10, 1, 1
    CONTROL SEND hDlg, %IDC_UD_YCNT, %UDM_SETBUDDY, GetDlgItem(hDlg, %IDC_T_YCNT), 0&
    CONTROL SEND hDlg, %IDC_UD_YCNT, %UDM_SETRANGE, 0&, MAKLNG (99,1)

    CONTROL ADD LABEL,   hDlg, %IDC_LABEL3, "year(s).", 304, 16, 48, 16

    CONTROL ADD BUTTON,  hDlg, %IDC_BUTTON1, "View/change script", 8, 48, 140, 24
    CONTROL ADD BUTTON,  hDlg, %IDC_BUTTON2, "GENERATE  ICS", 192, 46, 152, 28

    CONTROL ADD "RichEdit", hDlg, %IDC_TEXTBOX, "", 8, 88, 336, 230, _
      %WS_CHILD OR %WS_VISIBLE OR %ES_MULTILINE OR %ES_READONLY _
      OR %WS_VSCROLL
    Fill_RichEdit (hDlg, %IDC_TEXTBOX)

    DIALOG SHOW MODAL hDlg, CALL ProcMain TO lRes
    FUNCTION = lRes
END FUNCTION
'------------------------------------------------------------------------------